home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 1
/
SPACE - Library 1 - Volume 1.iso
/
program
/
363
/
xlisp20
/
xlisp_c
/
xlfio.c
< prev
next >
Wrap
Text File
|
1990-02-03
|
7KB
|
328 lines
/* xlfio.c - xlisp file i/o */
/* Copyright (c) 1985, by David Michael Betz
All Rights Reserved
Permission is granted for unrestricted non-commercial use */
#include "xlisp.h"
/* external variables */
extern NODE *s_stdin,*s_stdout;
extern NODE *xlstack;
extern int xlfsize;
extern char buf[];
/* external routines */
extern FILE *fopen();
/* forward declarations */
FORWARD NODE *printit();
FORWARD NODE *flatsize();
FORWARD NODE *openit();
/* xread - read an expression */
NODE *xread(args)
NODE *args;
{
NODE *oldstk,fptr,eof,*val;
/* create a new stack frame */
oldstk = xlsave(&fptr,&eof,NULL);
/* get file pointer and eof value */
fptr.n_ptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
eof.n_ptr = (args ? xlarg(&args) : NIL);
xllastarg(args);
/* read an expression */
if (!xlread(fptr.n_ptr,&val))
val = eof.n_ptr;
/* restore the previous stack frame */
xlstack = oldstk;
/* return the expression */
return (val);
}
/* xprint - builtin function 'print' */
NODE *xprint(args)
NODE *args;
{
return (printit(args,TRUE,TRUE));
}
/* xprin1 - builtin function 'prin1' */
NODE *xprin1(args)
NODE *args;
{
return (printit(args,TRUE,FALSE));
}
/* xprinc - builtin function princ */
NODE *xprinc(args)
NODE *args;
{
return (printit(args,FALSE,FALSE));
}
/* xterpri - terminate the current print line */
NODE *xterpri(args)
NODE *args;
{
NODE *fptr;
/* get file pointer */
fptr = (args ? xlgetfile(&args) : getvalue(s_stdout));
xllastarg(args);
/* terminate the print line and return nil */
xlterpri(fptr);
return (NIL);
}
/* printit - common print function */
LOCAL NODE *printit(args,pflag,tflag)
NODE *args; int pflag,tflag;
{
NODE *oldstk,fptr,val;
/* create a new stack frame */
oldstk = xlsave(&fptr,&val,NULL);
/* get expression to print and file pointer */
val.n_ptr = xlarg(&args);
fptr.n_ptr = (args ? xlgetfile(&args) : getvalue(s_stdout));
xllastarg(args);
/* print the value */
xlprint(fptr.n_ptr,val.n_ptr,pflag);
/* terminate the print line if necessary */
if (tflag)
xlterpri(fptr.n_ptr);
/* restore the previous stack frame */
xlstack = oldstk;
/* return the result */
return (val.n_ptr);
}
/* xflatsize - compute the size of a printed representation using prin1 */
NODE *xflatsize(args)
NODE *args;
{
return (flatsize(args,TRUE));
}
/* xflatc - compute the size of a printed representation using princ */
NODE *xflatc(args)
NODE *args;
{
return (flatsize(args,FALSE));
}
/* flatsize - compute the size of a printed expression */
LOCAL NODE *flatsize(args,pflag)
NODE *args; int pflag;
{
NODE *oldstk,val;
/* create a new stack frame */
oldstk = xlsave(&val,NULL);
/* get the expression */
val.n_ptr = xlarg(&args);
xllastarg(args);
/* print the value to compute its size */
xlfsize = 0;
xlprint(NIL,val.n_ptr,pflag);
/* restore the previous stack frame */
xlstack = oldstk;
/* return the length of the expression */
return (cvfixnum((FIXNUM)xlfsize));
}
/* xopeni - open an input file */
NODE *xopeni(args)
NODE *args;
{
return (openit(args,"r"));
}
/* xopeno - open an output file */
NODE *xopeno(args)
NODE *args;
{
return (openit(args,"w"));
}
/* openit - common file open routine */
LOCAL NODE *openit(args,mode)
NODE *args; char *mode;
{
NODE *fname,*val;
FILE *fp;
/* get the file name */
fname = xlmatch(STR,&args);
xllastarg(args);
/* try to open the file */
if ((fp = fopen(fname->n_str,mode)) != NULL) {
val = newnode(FPTR);
val->n_fp = fp;
val->n_savech = 0;
}
else
val = NIL;
/* return the file pointer */
return (val);
}
/* xclose - close a file */
NODE *xclose(args)
NODE *args;
{
NODE *fptr;
/* get file pointer */
fptr = xlmatch(FPTR,&args);
xllastarg(args);
/* make sure the file exists */
if (fptr->n_fp == NULL)
xlfail("file not open");
/* close the file */
fclose(fptr->n_fp);
fptr->n_fp = NULL;
/* return nil */
return (NIL);
}
/* xrdchar - read a character from a file */
NODE *xrdchar(args)
NODE *args;
{
NODE *fptr;
int ch;
/* get file pointer */
fptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
xllastarg(args);
/* get character and check for eof */
return ((ch = xlgetc(fptr)) == EOF ? NIL : cvfixnum((FIXNUM)ch));
}
/* xpkchar - peek at a character from a file */
NODE *xpkchar(args)
NODE *args;
{
NODE *flag,*fptr;
int ch;
/* peek flag and get file pointer */
flag = (args ? xlarg(&args) : NIL);
fptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
xllastarg(args);
/* skip leading white space and get a character */
if (flag)
while ((ch = xlpeek(fptr)) != EOF && isspace(ch))
xlgetc(fptr);
else
ch = xlpeek(fptr);
/* return the character */
return (ch == EOF ? NIL : cvfixnum((FIXNUM)ch));
}
/* xwrchar - write a character to a file */
NODE *xwrchar(args)
NODE *args;
{
NODE *fptr,*chr;
/* get the character and file pointer */
chr = xlmatch(INT,&args);
fptr = (args ? xlgetfile(&args) : getvalue(s_stdout));
xllastarg(args);
/* put character to the file */
xlputc(fptr,(int)chr->n_int);
/* return the character */
return (chr);
}
/* xreadline - read a line from a file */
NODE *xreadline(args)
NODE *args;
{
NODE *oldstk,fptr,str;
char *p,*sptr;
int len,ch;
/* create a new stack frame */
oldstk = xlsave(&fptr,&str,NULL);
/* get file pointer */
fptr.n_ptr = (args ? xlgetfile(&args) : getvalue(s_stdin));
xllastarg(args);
/* make a string node */
str.n_ptr = newnode(STR);
str.n_ptr->n_strtype = DYNAMIC;
/* get character and check for eof */
len = 0; p = buf;
while ((ch = xlgetc(fptr.n_ptr)) != EOF && ch != '\n') {
/* check for buffer overflow */
if ((int)(p - buf) == STRMAX) {
*p = 0;
sptr = stralloc(len + STRMAX); *sptr = 0;
if (len) {
strcpy(sptr,str.n_ptr->n_str);
strfree(str.n_ptr->n_str);
}
str.n_ptr->n_str = sptr;
strcat(sptr,buf);
len += STRMAX;
p = buf;
}
/* store the character */
*p++ = ch;
}
/* check for end of file */
if (len == 0 && p == buf && ch == EOF) {
xlstack = oldstk;
return (NIL);
}
/* append the last substring */
*p = 0;
sptr = stralloc(len + (int)(p - buf)); *sptr = 0;
if (len) {
strcpy(sptr,str.n_ptr->n_str);
strfree(str.n_ptr->n_str);
}
str.n_ptr->n_str = sptr;
strcat(sptr,buf);
/* restore the previous stack frame */
xlstack = oldstk;
/* return the string */
return (str.n_ptr);
}
əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə